home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / dsdesign.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  36KB  |  1,313 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Dataset Designer                                }
  6. {                                                       }
  7. {       Copyright (c) 1997,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DSDesign;
  12.  
  13. interface
  14.  
  15. uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
  16.   Forms, StdCtrls, ExtCtrls, DB, DBCtrls, DsgnIntf, LibIntf,
  17.   DsnDBCst, DsgnWnds, Menus, DrpCtrls;
  18.  
  19. type
  20.  
  21.   TSelectionProc = function(Field: TField): Boolean of object;
  22.  
  23.   TDSDesigner = class;
  24.   TDSDesignerClass = class of TDSDesigner;
  25.  
  26.   TFieldsEditor = class(TDesignWindow)
  27.     Panel1: TPanel;
  28.     DataSource: TDataSource;
  29.     LocalMenu: TPopupMenu;
  30.     AddItem: TMenuItem;
  31.     NewItem: TMenuItem;
  32.     N1: TMenuItem;
  33.     CutItem: TMenuItem;
  34.     CopyItem: TMenuItem;
  35.     PasteItem: TMenuItem;
  36.     DeleteItem: TMenuItem;
  37.     SelectAllItem: TMenuItem;
  38.     FieldListBox: TListBox;
  39.     DBNavigator: TDBNavigator;
  40.     Addallfields1: TMenuItem;
  41.     AggListBox: TListBox;
  42.     Splitter1: TSplitter;
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure FormDestroy(Sender: TObject);
  45.     procedure AddItemClick(Sender: TObject);
  46.     procedure DeleteItemClick(Sender: TObject);
  47.     procedure FieldListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
  48.       State: TDragState; var Accept: Boolean);
  49.     procedure FieldListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
  50.     procedure AListBoxKeyDown(Sender: TObject; var Key: Word;
  51.       Shift: TShiftState);
  52.     procedure NewItemClick(Sender: TObject);
  53.     procedure SelectTable(Sender: TObject);
  54.     procedure AListBoxClick(Sender: TObject);
  55.     procedure AListBoxKeyPress(Sender: TObject; var Key: Char);
  56.     procedure ClearAllClick(Sender: TObject);
  57.     procedure FieldListBoxStartDrag(Sender: TObject;
  58.       var DragObject: TDragObject);
  59.     procedure SelectAllItemClick(Sender: TObject);
  60.     procedure CutItemClick(Sender: TObject);
  61.     procedure CopyItemClick(Sender: TObject);
  62.     procedure PasteItemClick(Sender: TObject);
  63.     procedure LocalMenuPopup(Sender: TObject);
  64.     procedure AddAllFields(Sender: TObject);
  65.   private
  66.     FDSDesignerClass: TDSDesignerClass;
  67.     FDragObject: TDragObject;
  68.     FDSDesigner: TDSDesigner;
  69.     FForm: TCustomForm;
  70.     FDataset: TDataset;
  71.     FFocusRectItem: Integer;
  72.     FMinWidth, FMinHeight: Integer;
  73.     procedure AddFields(All: Boolean);
  74.     procedure Copy;
  75.     function CreateFields(FieldsList: TListBox): TField;
  76.     procedure Cut;
  77.     procedure MoveFields(MoveOffset: Integer);
  78.     procedure Paste;
  79.     procedure RemoveFields(Listbox: TListbox);
  80.     procedure SelectAll;
  81.     procedure RestoreSelection(List: TListBox; var Selection: TStringList;
  82.       ItemIndex, TopIndex: Integer; RestoreUpdate: Boolean);
  83.     procedure SaveSelection(List: TListBox; var Selection: TStringList;
  84.       var ItemIndex, TopIndex: Integer; NoUpdate: Boolean);
  85.     procedure SetDataset(Value: TDataset);
  86.     procedure UpdateDisplay;
  87.     procedure UpdateCaption;
  88.     procedure UpdateFieldList;
  89.     procedure UpdateSelection;
  90.     procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  91.     function GetActiveListbox: TListbox;
  92.   protected
  93.     procedure Activated; override;
  94.     procedure CheckFieldDelete;
  95.     procedure CheckFieldAdd;
  96.     function UniqueName(Component: TComponent): string; override;
  97.   public
  98.     destructor Destroy; override;
  99.     procedure ComponentDeleted(Component: IPersistent); override;
  100.     function GetEditState: TEditState; override;
  101.     procedure EditAction(Action: TEditAction); override;
  102.     function ForEachSelection(Proc: TSelectionProc): Boolean;
  103.     procedure FormModified; override;
  104.     procedure SelectionChanged(ASelection: TDesignerSelectionList); override;
  105.     function DoNewField: TField;
  106.     function DoNewLookupField(const ADataSet, AKey, ALookup, AResult,
  107.       AType: string; ASize: Word): TField;
  108.     function DoAddFields(All: Boolean): TField;
  109.     property Form: TCustomForm read FForm write FForm;
  110.     property Dataset: TDataset read FDataset write SetDataset;
  111.     property DSDesignerClass: TDSDesignerClass read FDSDesignerClass write FDSDesignerClass;
  112.     property DSDesigner: TDSDesigner read FDSDesigner;
  113.   end;
  114.  
  115. { TDSDesigner }
  116.  
  117.   TDSDesigner = class(TDatasetDesigner)
  118.   private
  119.     FFieldsEditor: TFieldsEditor;
  120.   public
  121.     destructor Destroy; override;
  122.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  123.  
  124.     procedure BeginCreateFields; virtual;
  125.     procedure BeginUpdateFieldDefs; virtual;
  126.     function DoCreateField(const FieldName: string; Origin: string): TField; virtual;
  127.     procedure EndCreateFields; virtual;
  128.     procedure EndUpdateFieldDefs; virtual;
  129.     function GetControlClass(Field: TField): string; virtual;
  130.     procedure InitializeMenu(Menu: TPopupMenu); virtual;
  131.     function SupportsAggregates: Boolean; virtual;
  132.     function SupportsInternalCalc: Boolean; virtual;
  133.     procedure UpdateMenus(Menu: TPopupMenu; EditState: TEditState); virtual;
  134.     property FieldsEditor: TFieldsEditor read FFieldsEditor;
  135.   end;
  136.  
  137. procedure ShowFieldsEditor(Designer: IFormDesigner; ADataset: TDataset;
  138.   DesignerClass: TDSDesignerClass);
  139.  
  140. function CreateFieldsEditor(Designer: IFormDesigner; ADataset: TDataset;
  141.   DesignerClass: TDSDesignerClass; var Shared: Boolean): TFieldsEditor;
  142.  
  143. function CreateUniqueName(Dataset: TDataset; const FieldName: string;
  144.   FieldClass: TFieldClass; Component: TComponent): string;
  145.  
  146. var
  147.   DesignerCount: Integer;
  148.  
  149. implementation
  150.  
  151. uses
  152.   Dialogs, TypInfo, Math, LibHelp, DSAdd, DSDefine, DesignConst;
  153.  
  154. { TDSDesigner }
  155.  
  156. destructor TDSDesigner.Destroy;
  157. begin
  158.   if FFieldsEditor <> nil then
  159.   begin
  160.     FFieldsEditor.FDSDesigner := nil;
  161.     FFieldsEditor.Release;
  162.   end;
  163.   inherited Destroy;
  164. end;
  165.  
  166. procedure TDSDesigner.DataEvent(Event: TDataEvent; Info: Longint);
  167. begin
  168.   if Event = deFieldListChange then FFieldsEditor.UpdateFieldList;
  169. end;
  170.  
  171. function TDSDesigner.GetControlClass(Field: TField): string;
  172. begin
  173.   Result := '';
  174. end;
  175.  
  176. function TDSDesigner.SupportsAggregates: Boolean;
  177. begin
  178.   Result := False;
  179. end;
  180.  
  181. function TDSDesigner.SupportsInternalCalc: Boolean;
  182. begin
  183.   Result := False;
  184. end;
  185.  
  186. procedure TDSDesigner.BeginUpdateFieldDefs;
  187. begin
  188. end;
  189.  
  190. procedure TDSDesigner.EndUpdateFieldDefs;
  191. begin
  192. end;
  193.  
  194. procedure TDSDesigner.BeginCreateFields;
  195. begin
  196. end;
  197.  
  198. procedure TDSDesigner.EndCreateFields;
  199. begin
  200. end;
  201.  
  202. procedure TDSDesigner.InitializeMenu(Menu: TPopupMenu);
  203. begin
  204. end;
  205.  
  206. procedure TDSDesigner.UpdateMenus(Menu: TPopupMenu; EditState: TEditState);
  207. begin
  208. end;
  209.  
  210. function TDSDesigner.DoCreateField(const FieldName: string; Origin: string): TField;
  211. var
  212.   FieldDef: TFieldDef;
  213.   ParentField: TField;
  214.   SubScript,
  215.   ShortName,
  216.   ParentFullName: String;
  217. begin
  218.   FieldDef := Dataset.FieldDefList.FieldByName(FieldName);
  219.   ParentField := nil;
  220.   if Dataset.ObjectView then
  221.   begin
  222.     if FieldDef.ParentDef <> nil then
  223.     begin
  224.       if FieldDef.ParentDef.DataType = ftArray then
  225.       begin
  226.         { Strip off the subscript to determine the parent's full name }
  227.         SubScript := Copy(FieldName, AnsiPos('[', FieldName), MaxInt);
  228.         ParentFullName := Copy(FieldName, 1, Length(FieldName) - Length(SubScript));
  229.         ShortName := FieldDef.ParentDef.Name + SubScript;
  230.       end
  231.       else
  232.       begin
  233.         if faUnNamed in FieldDef.ParentDef.Attributes then
  234.           ParentFullName := FieldDef.ParentDef.Name else
  235.           ParentFullName := ChangeFileExt(FieldName, '');
  236.         ShortName := FieldDef.Name;
  237.       end;
  238.       ParentField := Dataset.FieldList.Find(ParentFullName);
  239.       if ParentField = nil then
  240.         ParentField := DoCreateField(ParentFullName, Origin);
  241.     end
  242.     else
  243.       ShortName := FieldDef.Name;
  244.   end
  245.   else
  246.     ShortName := FieldName;
  247.   Result := FieldDef.CreateField(DataSet.Owner, ParentField as TObjectField, ShortName, False);
  248.   try
  249.     Result.Origin := Origin;
  250.     Result.Name := CreateUniqueName(Dataset, FieldName, TFieldClass(ClassType), nil);
  251.   except
  252.     Result.Free;
  253.     raise;
  254.   end;
  255. end;
  256.  
  257. { Utility functions }
  258.  
  259. procedure ShowFieldsEditor(Designer: IFormDesigner; ADataset: TDataset;
  260.   DesignerClass: TDSDesignerClass);
  261. var
  262.   FieldsEditor: TFieldsEditor;
  263.   vShared: Boolean;
  264. begin
  265.   FieldsEditor := CreateFieldsEditor(Designer, ADataSet, DesignerClass, vShared);
  266.   if FieldsEditor <> nil then
  267.     FieldsEditor.Show;
  268. end;
  269.  
  270. function CreateFieldsEditor(Designer: IFormDesigner; ADataset: TDataset;
  271.   DesignerClass: TDSDesignerClass; var Shared: Boolean): TFieldsEditor;
  272. begin
  273.   Shared := True;
  274.   if ADataset.Designer <> nil then
  275.     Result := (ADataset.Designer as TDSDesigner).FFieldsEditor
  276.   else
  277.   begin
  278.     Result := TFieldsEditor.Create(Application);
  279.     Result.DSDesignerClass := DesignerClass;
  280.     Result.Designer := Designer;
  281.     Result.Form := Designer.Form;
  282.     Result.Dataset := ADataset;
  283.     Shared := False;
  284.   end;
  285. end;
  286.  
  287. function GenerateName(Dataset: TDataset; FieldName: string;
  288.   FieldClass: TFieldClass; Number: Integer): string;
  289. var
  290.   Fmt: string;
  291.  
  292.   procedure CrunchFieldName;
  293.   var
  294.     I: Integer;
  295.   begin
  296.     I := 1;
  297.     while I <= Length(FieldName) do
  298.     begin
  299.       if FieldName[I] in ['A'..'Z','a'..'z','_','0'..'9'] then
  300.         Inc(I)
  301.       else if FieldName[I] in LeadBytes then
  302.         Delete(FieldName, I, 2)
  303.       else
  304.         Delete(FieldName, I, 1);
  305.     end;
  306.   end;
  307.  
  308. begin
  309.   CrunchFieldName;
  310.   if (FieldName = '') or (FieldName[1] in ['0'..'9']) then
  311.   begin
  312.     if FieldClass <> nil then
  313.       FieldName := FieldClass.ClassName + FieldName else
  314.       FieldName := 'Field' + FieldName;
  315.     if FieldName[1] = 'T' then Delete(FieldName, 1, 1);
  316.     CrunchFieldName;
  317.   end;
  318.   Fmt := '%s%s%d';
  319.   if Number < 2 then Fmt := '%s%s';
  320.   Result := Format(Fmt, [Dataset.Name, FieldName, Number]);
  321. end;
  322.  
  323. function CreateUniqueName(Dataset: TDataset; const FieldName: string;
  324.   FieldClass: TFieldClass; Component: TComponent): string;
  325. var
  326.   I: Integer;
  327.  
  328.   function IsUnique(const AName: string): Boolean;
  329.   var
  330.     I: Integer;
  331.   begin
  332.     Result := False;
  333.     with Dataset.Owner do
  334.       for I := 0 to ComponentCount - 1 do
  335.         if (Component <> Components[i]) and (CompareText(AName, Components[I].Name) = 0) then Exit;
  336.     Result := True;
  337.   end;
  338.  
  339. begin
  340.   for I := 1 to MaxInt do
  341.   begin
  342.     Result := Generatename(Dataset, FieldName, FieldClass, I);
  343.     if IsUnique(Result) then Exit;
  344.   end;
  345. end;
  346.  
  347. { TDragFields }
  348.  
  349. type
  350.   TDragFields = class(TDragControlObject)
  351.   private
  352.     FEditor: TFieldsEditor;
  353.   public
  354.     constructor Create(AControl: TControl; AEditor: TFieldsEditor); reintroduce;
  355.     property Editor: TFieldsEditor read FEditor;
  356.   end;
  357.  
  358. constructor TDragFields.Create(AControl: TControl; AEditor: TFieldsEditor);
  359. begin
  360.   inherited Create(AControl);
  361.   FEditor := AEditor;
  362. end;
  363.  
  364. { TFieldsTarget }
  365.  
  366. type
  367.   TFieldsTarget = class(TDragTarget)
  368.   public
  369.     function DragOver(Target, Source: TObject; X, Y: Integer;
  370.       State: TDragState): Boolean; override;
  371.     procedure DragDrop(Target, Source: TObject; X, Y: Integer); override;
  372.   end;
  373.  
  374. function TFieldsTarget.DragOver(Target, Source: TObject; X, Y: Integer;
  375.   State: TDragState): Boolean;
  376. begin
  377.   Result := True;
  378. end;
  379.  
  380. procedure TFieldsTarget.DragDrop(Target, Source: TObject; X, Y: Integer);
  381. var
  382.   SourceRoot: TComponent;
  383.   Control: TControl;
  384.   I: Integer;
  385.   Editor: TFieldsEditor;
  386.   FieldList: TList;
  387.   Field: TField;
  388. begin
  389.   SourceRoot := TDragFields(Source).Editor.Designer.GetRoot;
  390.   if not Designer.IsComponentLinkable(SourceRoot) then
  391.     if MessageDlg(Format(SDSLinkForms, [Designer.GetRoot.Name,
  392.       SourceRoot.Name]), mtConfirmation, mbYesNoCancel, 0) <> idYes then
  393.         Exit
  394.     else
  395.       Designer.MakeComponentLinkable(SourceRoot);
  396.   FieldList := TList.Create;
  397.   try
  398.     { Collect the fields before creating the controls since creating the first
  399.       control will remove all the sections }
  400.     Editor := TDragFields(Source).Editor;
  401.     with Editor do
  402.     begin
  403.       for I := 0 to FieldListBox.Items.Count - 1 do
  404.         if FieldListBox.Selected[I] then
  405.           FieldList.Add(FieldListBox.Items.Objects[I]{Dataset.FieldByName(FieldListBox.Items[I])});
  406.     end;
  407.     Screen.Cursor := crHourGlass;
  408.     try
  409.       for I := 0 to FieldList.Count - 1 do
  410.       begin
  411.         Field := TField(FieldList[I]);
  412.         Control := CreateFieldControl(Designer, Field,
  413.           Editor.DSDesigner.GetControlClass(Field), TComponent(Target), X, Y, True);
  414.         Y := Control.Top + Control.Height + 5;
  415.       end;
  416.     finally
  417.       Screen.Cursor := crDefault;
  418.     end;
  419.   finally
  420.     FieldList.Free;
  421.   end;
  422. end;
  423.  
  424. {$R *.DFM}
  425.  
  426. { TFieldsEditor }
  427.  
  428. destructor TFieldsEditor.Destroy;
  429. begin
  430.   FDragObject.Free;
  431.   FDragObject := nil;
  432.   inherited Destroy;
  433. end;
  434.  
  435. procedure TFieldsEditor.UpdateDisplay;
  436. begin
  437.   UpdateFieldList;
  438.   UpdateCaption;
  439.   UpdateSelection;
  440. end;
  441.  
  442. procedure TFieldsEditor.SaveSelection(List: TListBox;
  443.   var Selection: TStringList; var ItemIndex, TopIndex: Integer;
  444.   NoUpdate: Boolean);
  445. var
  446.   I: Integer;
  447. begin
  448.   Selection := TStringList.Create;
  449.   try
  450.     ItemIndex := List.ItemIndex;
  451.     TopIndex := List.TopIndex;
  452.     with List do
  453.       for I := 0 to Items.Count - 1 do
  454.         if Selected[I] then Selection.Add(Items[I]);
  455.     if NoUpdate then List.Items.BeginUpdate;
  456.   except
  457.     Selection.Free;
  458.     Selection := nil;
  459.   end;
  460. end;
  461.  
  462. procedure TFieldsEditor.RestoreSelection(List: TListBox;
  463.   var Selection: TStringList; ItemIndex, TopIndex: Integer;
  464.   RestoreUpdate: Boolean);
  465. var
  466.   I: Integer;
  467. begin
  468.   try
  469.     with List do
  470.       for I := 0 to Items.Count - 1 do
  471.         Selected[I] := Selection.IndexOf(Items[I]) <> -1;
  472.     if TopIndex <> -1 then List.TopIndex := TopIndex;
  473.     if ItemIndex <> -1 then List.ItemIndex := ItemIndex;
  474.   finally
  475.     if RestoreUpdate then List.Items.EndUpdate;
  476.     List.Invalidate;
  477.     Selection.Free;
  478.     Selection := nil;
  479.     UpdateSelection;
  480.   end;
  481. end;
  482.  
  483. procedure TFieldsEditor.UpdateCaption;
  484. var
  485.   NewCaption: string;
  486. begin
  487.   if (Dataset <> nil) and (Dataset.Owner <> nil) then
  488.     NewCaption := Format(SDatasetEditor, [Dataset.Owner.Name, DotSep,
  489.       Dataset.Name]);
  490.   if Caption <> NewCaption then Caption := NewCaption;
  491. end;
  492.  
  493. procedure TFieldsEditor.UpdateFieldList;
  494. var
  495.   ItemIndex, TopIndex: Integer;
  496.   Selection: TStringList;
  497.   EnableList: Boolean;
  498.   I: Integer;
  499.   Field: TField;
  500.   FieldName: string;
  501.   ActiveListbox: TListbox;
  502. begin
  503.   ActiveListbox := GetActiveListbox;
  504.   SaveSelection(ActiveListBox, Selection, ItemIndex, TopIndex, True);
  505.   try
  506.     FieldListBox.Clear;
  507.     AggListBox.Clear;
  508.     EnableList := False;
  509.     try
  510.       if Dataset = nil then Exit;
  511.       for I := 0 to Dataset.FieldList.Count - 1 do
  512.       begin
  513.         Field := Dataset.FieldList[I];
  514.         if not (csDestroying in Field.ComponentState) and
  515.            (Field.Owner = Dataset.Owner) then
  516.         begin
  517.           FieldName := Field.FullName;
  518.           if FieldName = '' then
  519.             FieldName := Format('<%s>', [Dataset.FieldList[I].Name]);
  520.           FieldListbox.Items.AddObject(FieldName, Field);
  521.         end;
  522.       end;
  523.  
  524.       for I := 0 to Dataset.AggFields.Count - 1 do
  525.       begin
  526.         Field := Dataset.AggFields[I];
  527.         if not (csDestroying in Field.ComponentState) and
  528.            (Field.Owner = Dataset.Owner) then
  529.         begin
  530.           FieldName := Field.FullName;
  531.           if FieldName = '' then
  532.             FieldName := Format('<%s>', [Dataset.AggFields[I].Name]);
  533.           AggListbox.Items.AddObject(FieldName, Field);
  534.         end;
  535.       end;
  536.       with AggListbox do
  537.         if Items.Count > 0 then
  538.         begin
  539.           Visible := True;
  540.           Splitter1.Visible := True;
  541.         end
  542.         else
  543.         begin
  544.           Visible := False;
  545.           Splitter1.Visible := False;
  546.         end;
  547.  
  548.       EnableList := True;
  549.     finally
  550.       FieldListBox.Enabled := EnableList;
  551.       AggListBox.Enabled := EnableList and (AggListBox.Items.Count > 0);
  552.     end;
  553.   finally
  554.     if ActiveListBox.Visible then
  555.       RestoreSelection(ActiveListBox, Selection, ItemIndex, TopIndex, True)
  556.     else if ActiveListBox = AggListbox then
  557.       ActiveListBox.Items.EndUpdate;
  558.   end;
  559. end;
  560.  
  561. procedure TFieldsEditor.UpdateSelection;
  562. var
  563.   I: Integer;
  564.   Field: TField;
  565.   ComponentList: TDesignerSelectionList;
  566. begin
  567.   if Active then
  568.   begin
  569.     ComponentList := TDesignerSelectionList.Create;
  570.     try
  571.       with GetActiveListBox do
  572.         for I := 0 to Items.Count - 1 do
  573.           if Selected[I] then
  574.           begin
  575.             Field := TField(Items.Objects[I]){Dataset.FindField(Items[I])};
  576.             if Field <> nil then ComponentList.Add(Field);
  577.           end;
  578.       if ComponentList.Count = 0 then ComponentList.Add(Dataset);
  579.     except
  580.       ComponentList.Free;
  581.       raise;
  582.     end;
  583.     SetSelection(ComponentList);
  584.   end;
  585. end;
  586.  
  587. function TFieldsEditor.CreateFields(FieldsList: TListBox): TField;
  588. var
  589.   I: Integer;
  590.   ItemIndex, TopIndex: Integer;
  591.   Selection: TStringList;
  592.   FocusedListbox: TListbox;
  593.   Fields: TStringList;
  594. begin
  595.   Result := nil;
  596.   FocusedListbox := nil;
  597.   if Visible then
  598.   begin
  599.     FocusedListBox := GetActiveListBox;
  600.     SaveSelection(FocusedListbox, Selection, ItemIndex, TopIndex, False);
  601.   end;
  602.   try
  603.     Screen.Cursor := crHourGlass;
  604.     try
  605.       FDSDesigner.BeginDesign;
  606.       try
  607.         Fields := TStringList.Create;
  608.         try
  609.           for i := 0 to FieldsList.Items.Count - 1 do
  610.             if FieldsList.Selected[i] then
  611.               Fields.Add(FieldsList.Items[i]);
  612.           DSDesigner.BeginCreateFields;
  613.           try
  614.             for I := 0 to Fields.Count - 1 do
  615.               Result := DSDesigner.DoCreateField(Fields[I], '');
  616.             Designer.Modified;
  617.           finally
  618.             DSDesigner.EndCreateFields;
  619.           end;
  620.         finally
  621.           Fields.Free;
  622.         end;
  623.       finally
  624.         FDSDesigner.EndDesign;
  625.       end;
  626.     finally
  627.       Screen.Cursor := crDefault;
  628.     end;
  629.   finally
  630.     if FocusedListbox <> nil then
  631.     begin
  632.       UpdateDisplay;
  633.       RestoreSelection(FocusedListBox, Selection, -1, -1, False);
  634.     end;
  635.   end;
  636. end;
  637.  
  638. procedure TFieldsEditor.SelectAll;
  639. var
  640.   I: Integer;
  641. begin
  642.   with FieldListBox do
  643.     for I := 0 to Items.Count - 1 do Selected[I] := True;
  644. end;
  645.  
  646. procedure TFieldsEditor.RemoveFields(Listbox: TListbox);
  647. var
  648.   I, Focused: Integer;
  649. begin
  650.   CheckFieldDelete;
  651.   try
  652.     FDSDesigner.BeginDesign;
  653.     try
  654.       Focused := ListBox.ItemIndex;
  655.       with ListBox do
  656.         for I := Items.Count - 1 downto 0 do
  657.           if Selected[I] then
  658.             TField(Items.Objects[I]).Free;
  659.             //Dataset.FindField(Items[I]).Free;
  660.       Designer.Modified;
  661.     finally
  662.       FDSDesigner.EndDesign;
  663.     end;
  664.   finally
  665.     UpdateDisplay;
  666.   end;
  667.   if Focused <> -1 then
  668.   begin
  669.     Focused := Min(Focused, ListBox.Items.Count - 1);
  670.     ListBox.ItemIndex := Focused;
  671.     ListBox.Selected[Focused] := True;
  672.     UpdateSelection;
  673.   end;
  674.   if (ListBox = AggListBox) and (ListBox.Items.Count = 0) then
  675.     FieldListBox.SetFocus
  676.   else
  677.     ListBox.SetFocus;
  678. end;
  679.  
  680. procedure TFieldsEditor.MoveFields(MoveOffset: Integer);
  681. var
  682.   I, E: Integer;
  683. begin
  684.   try
  685.     DataSet.DisableControls;
  686.     try
  687.       with FieldListBox do
  688.       begin
  689.         I := 0;
  690.         E := Items.Count;
  691.         if MoveOffset > 0 then
  692.         begin
  693.           I := E - 1;
  694.           E := -1;
  695.         end;
  696.         while I <> E do
  697.         begin
  698.           if Selected[I] then
  699.             with TField(Items.Objects[I]){Dataset.FieldByName(Items[I])} do
  700.               Index := Index + MoveOffset;
  701.           Inc(I, -MoveOffset);
  702.         end;
  703.       end;
  704.     finally
  705.       DataSet.EnableControls;
  706.     end;
  707.   finally
  708.     UpdateDisplay;
  709.     Designer.Modified;
  710.   end;
  711. end;
  712.  
  713. procedure TFieldsEditor.SetDataset(Value: TDataset);
  714. begin
  715.   if FDataSet <> Value then
  716.   begin
  717.     if FDataSet <> nil then
  718.     begin
  719.       FreeAndNil(FDSDesigner);
  720.       DataSource.DataSet := nil;
  721.     end;
  722.     FDataset := Value;
  723.     if FDataSet <> nil then
  724.     begin
  725.       FDSDesigner := DSDesignerClass.Create(Value);
  726.       FDSDesigner.FFieldsEditor := Self;
  727.       FDSDesigner.InitializeMenu(LocalMenu);
  728.       DataSource.DataSet := Value;
  729.       UpdateDisplay;
  730.     end
  731.     else
  732.       Release;
  733.   end;
  734. end;
  735.  
  736. procedure TFieldsEditor.FormCreate(Sender: TObject);
  737. begin
  738.   Inc(DesignerCount);
  739.   FMinWidth := Width;
  740.   FMinHeight := Height;
  741.   HelpContext := hcDataSetDesigner;
  742. end;
  743.  
  744. procedure TFieldsEditor.FormDestroy(Sender: TObject);
  745. begin
  746.   if FDSDesigner <> nil then
  747.   begin
  748.     { Destroy the designer if the editor is destroyed }
  749.     FDSDesigner.FFieldsEditor := nil;
  750.     FDSDesigner.Free;
  751.   end;
  752.   Dec(DesignerCount);
  753. end;
  754.  
  755. procedure TFieldsEditor.AddFields(All: Boolean);
  756. begin
  757.   DoAddFields(All);
  758.   FieldListBox.SetFocus;
  759. end;
  760.  
  761. function TFieldsEditor.DoAddFields(All: Boolean): TField;
  762. var
  763.   AddFields: TAddFields;
  764.   I: Integer;
  765.   FieldName: string;
  766.   Field: TField;
  767. begin
  768.   CheckFieldAdd;
  769.   Result := nil;
  770.   try
  771.     DSDesigner.BeginUpdateFieldDefs;
  772.     DataSet.FieldDefs.Update;
  773.   finally
  774.     DSDesigner.EndUpdateFieldDefs;
  775.   end;
  776.   AddFields := TAddFields.Create(Application);
  777.   try
  778.     { Add physical fields not already represented by TField components to the
  779.       to the list of available fields }
  780.     for I := 0 to DataSet.FieldDefList.Count - 1 do
  781.       with Dataset.FieldDefList[I] do
  782.         if (FieldClass <> nil) and not (faHiddenCol in Attributes) then
  783.         begin
  784.           FieldName := DataSet.FieldDefList.Strings[I];
  785.           Field := DataSet.FindField(FieldName);
  786.           if (Field = nil) or (Field.Owner <> Dataset.Owner) then
  787.             AddFields.FieldsList.Items.Add(FieldName);
  788.         end;
  789.  
  790.     { Show the dialog }
  791.     AddFields.SelectAll;
  792.     AddFields.FieldsList.ItemIndex := 0;
  793.     if All or (AddFields.ShowModal <> mrCancel) then
  794.       Result := CreateFields(AddFields.FieldsList);
  795.   finally
  796.     AddFields.Release;
  797.   end;
  798. end;
  799.  
  800. procedure TFieldsEditor.AddItemClick(Sender: TObject);
  801. begin
  802.   AddFields(False);
  803. end;
  804.  
  805. procedure TFieldsEditor.DeleteItemClick(Sender: TObject);
  806. begin
  807.   RemoveFields(GetActiveListbox);
  808. end;
  809.  
  810. procedure TFieldsEditor.FieldListBoxDragOver(Sender, Source: TObject; X,
  811.   Y: Integer; State: TDragState; var Accept: Boolean);
  812. var
  813.   Item: Integer;
  814.  
  815.   procedure DrawRect(Item: Integer);
  816.   begin
  817.     if Item <> -1 then
  818.       with FieldlistBox do
  819.         Canvas.DrawFocusRect(ItemRect(Item));
  820.     FFocusRectItem := Item;
  821.   end;
  822.  
  823. begin
  824.   Item := FieldListBox.ItemAtPos(Point(X, Y), False);
  825.   Accept := (Source is TDragFields) and
  826.     (TDragFields(Source).Control = FieldListBox) and
  827.     (Item >= 0) and (Item < FieldListBox.Items.Count) and
  828.     not FieldListBox.Selected[Item];
  829.   if State = dsDragEnter then FFocusRectItem := -1;
  830.   if (State = dsDragLeave) or not Accept then Item := -1;
  831.   DrawRect(FFocusRectItem);
  832.   DrawRect(Item);
  833. end;
  834.  
  835. procedure TFieldsEditor.FieldListBoxDragDrop(Sender, Source: TObject; X,
  836.   Y: Integer);
  837. var
  838.   F: TField;
  839.   I: Integer;
  840. begin
  841.   if (Source is TDragFields) and (TDragFields(Source).Control = FieldListBox) then
  842.   begin
  843.     try
  844.       DataSet.DisableControls;
  845.       try
  846.         with FieldListBox do
  847.         begin
  848.           F := TField(Items.Objects[ItemAtPos(Point(X, Y), True)]){Dataset.FieldByName(Items[ItemAtPos(Point(X, Y), True)])};
  849.           for I := 0 to Items.Count - 1 do
  850.             if Selected[I] then
  851.               TField(Items.Objects[I]).Index{Dataset.FieldByName(Items[I]).Index} := F.Index;
  852.         end;
  853.       finally
  854.         DataSet.EnableControls;
  855.       end;
  856.     finally
  857.       UpdateDisplay;
  858.       Designer.Modified;
  859.     end;
  860.   end;
  861. end;
  862.  
  863. procedure TFieldsEditor.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
  864. begin
  865.   inherited;
  866.   with Message.MinMaxInfo^.ptMinTrackSize do
  867.   begin
  868.     X := FMinWidth;
  869.     Y := FMinHeight;
  870.   end;
  871. end;
  872.  
  873. procedure TFieldsEditor.AListBoxKeyDown(Sender: TObject;
  874.   var Key: Word; Shift: TShiftState);
  875. begin
  876.   case Key of
  877.     VK_INSERT: NewItemClick(Self);
  878.     VK_DELETE: RemoveFields(Sender as TListbox);
  879.     VK_UP:
  880.       if (ssCtrl in Shift) and (Sender = FieldListBox) then MoveFields(-1) else Exit;
  881.     VK_DOWN:
  882.       if (ssCtrl in Shift) and (Sender = FieldListBox) then MoveFields(1) else Exit;
  883.   else
  884.     Exit;
  885.   end;
  886.   Key := 0;
  887. end;
  888.  
  889. procedure TFieldsEditor.NewItemClick(Sender: TObject);
  890. var
  891.   //DefineField: TDefineField;
  892.   Selection: TStringList;
  893.   //Columns: Integer;
  894.   Field: TField;
  895. begin
  896.   CheckFieldAdd;
  897.   Field := DoNewField;
  898.   if Field <> nil then
  899.   begin
  900.     Selection := TStringList.Create;
  901.     try
  902.       Selection.Add(Field.FieldName);
  903.     finally
  904.       RestoreSelection(FieldListBox, Selection, -1, -1, False);
  905.     end;
  906.   end;
  907.   FieldListBox.SetFocus;
  908.  
  909.   {DefineField := TDefineField.Create(Application);
  910.   try
  911.     DefineField.DSDesigner := FDSDesigner;
  912.     DefineField.Designer := Designer;
  913.     DefineField.Dataset := Dataset;
  914.     Columns := 3;
  915.     if DSDesigner.SupportsInternalCalc then
  916.     begin
  917.       DefineField.FieldKind.Items.Add(SFKInternalCalc);
  918.       Inc(Columns);
  919.     end;
  920.     if DSDesigner.SupportsAggregates then
  921.     begin
  922.       DefineField.FieldKind.Items.Add(SFKAggregate);
  923.       Inc(Columns);
  924.     end;
  925.     DefineField.FieldKind.Columns := Columns;
  926.     with DefineField do
  927.       if ShowModal = mrOK then
  928.       begin
  929.         Self.Designer.Modified;
  930.         Self.UpdateDisplay;
  931.         Selection := TStringList.Create;
  932.         try
  933.           Selection.Add(FieldName);
  934.         finally
  935.           RestoreSelection(FieldListBox, Selection, -1, -1, False);
  936.         end;
  937.       end;
  938.   finally
  939.     DefineField.Release;
  940.   end;
  941.   FieldListBox.SetFocus;}
  942. end;
  943.  
  944. function TFieldsEditor.DoNewField: TField;
  945. var
  946.   DefineField: TDefineField;
  947.   //Selection: TStringList;
  948.   Columns: Integer;
  949. begin
  950.   Result := nil;
  951.   DefineField := TDefineField.Create(Application);
  952.   try
  953.     DefineField.DSDesigner := FDSDesigner;
  954.     DefineField.Designer := Designer;
  955.     DefineField.Dataset := Dataset;
  956.     Columns := 3;
  957.     if DSDesigner.SupportsInternalCalc then
  958.     begin
  959.       DefineField.FieldKind.Items.Add(SFKInternalCalc);
  960.       Inc(Columns);
  961.     end;
  962.     if DSDesigner.SupportsAggregates then
  963.     begin
  964.       DefineField.FieldKind.Items.Add(SFKAggregate);
  965.       Inc(Columns);
  966.     end;
  967.     DefineField.FieldKind.Columns := Columns;
  968.     if DefineField.ShowModal = mrOk then
  969.     begin
  970.       Result := DefineField.Field;
  971.       Designer.Modified;
  972.       if Visible then
  973.         UpdateDisplay;
  974.     end;
  975.   finally
  976.     DefineField.Release;
  977.   end;
  978. end;
  979.  
  980. function TFieldsEditor.DoNewLookupField(const ADataSet, AKey, ALookup,
  981.   AResult, AType: string; ASize: Word): TField;
  982. var
  983.   DefineField: TDefineField;
  984.   //Selection: TStringList;
  985.   //Columns: Integer;
  986. begin
  987.   CheckFieldAdd;
  988.   Result := nil;
  989.   DefineField := TDefineField.Create(Application);
  990.   try
  991.     DefineField.DSDesigner := FDSDesigner;
  992.     DefineField.Designer := Designer;
  993.     DefineField.Dataset := Dataset;
  994.     DefineField.ConfigureForLookupOnly(ADataSet, AKey, ALookup,
  995.                                        AResult, AType, ASize);
  996.     if DefineField.ShowModal = mrOk then
  997.     begin
  998.       Result := DefineField.Field;
  999.       Designer.Modified;
  1000.       if Visible then
  1001.         UpdateDisplay;
  1002.     end;
  1003.   finally
  1004.     DefineField.Release;
  1005.   end;
  1006. end;
  1007.  
  1008. procedure TFieldsEditor.Activated;
  1009. begin
  1010.   try
  1011.     UpdateSelection;
  1012.   except
  1013.     FieldListBox.Items.Clear;
  1014.   end;
  1015. end;
  1016.  
  1017. function TFieldsEditor.UniqueName(Component: TComponent): string;
  1018. begin
  1019.   Result := CreateUniqueName(Dataset, TField(Component).FullName,
  1020.     TFieldClass(Component.ClassType), Component);
  1021. end;
  1022.  
  1023. procedure TFieldsEditor.ComponentDeleted(Component: IPersistent);
  1024. var
  1025.   vItem: TPersistent;
  1026. begin
  1027.   vItem := ExtractPersistent(Component);
  1028.   if vItem = DataSet then
  1029.     DataSet := nil
  1030.   else if (vItem is TField) and
  1031.           (TField(vItem).DataSet = DataSet) then
  1032.     UpdateDisplay;
  1033. end;
  1034.  
  1035. function TFieldsEditor.GetEditState: TEditState;
  1036.  
  1037.   function FieldsSelected(Listbox: TListbox): Boolean;
  1038.   var
  1039.     I: Integer;
  1040.   begin
  1041.     Result := True;
  1042.     with ListBox do
  1043.       for I := 0 to Items.Count - 1 do
  1044.         if Selected[I] then Exit;
  1045.     Result := False;
  1046.   end;
  1047.  
  1048. begin
  1049.   Result := [];
  1050.   if ClipboardComponents then Result := [esCanPaste];
  1051.   if FieldsSelected(FieldListbox) or FieldsSelected(AggListBox) then
  1052.     Result := Result + [esCanCopy, esCanCut, esCanDelete];
  1053. end;
  1054.  
  1055. procedure TFieldsEditor.EditAction(Action: TEditAction);
  1056. begin
  1057.   case Action of
  1058.     eaCut: Cut;
  1059.     eaCopy: Copy;
  1060.     eaPaste: Paste;
  1061.     eaDelete: RemoveFields(GetActiveListbox);
  1062.     eaSelectAll:
  1063.       begin
  1064.         SelectAll;
  1065.         UpdateSelection;
  1066.       end;
  1067.   end;
  1068. end;
  1069.  
  1070. procedure TFieldsEditor.Cut;
  1071. begin
  1072.   CheckFieldDelete;
  1073.   Copy;
  1074.   RemoveFields(GetActiveListbox);
  1075. end;
  1076.  
  1077. procedure TFieldsEditor.Copy;
  1078. var
  1079.   I: Integer;
  1080.   ComponentList: TDesignerSelectionList;
  1081. begin
  1082.   ComponentList := TDesignerSelectionList.Create;
  1083.   try
  1084.     with GetActiveListBox do
  1085.       for I := 0 to Items.Count - 1 do
  1086.         if Selected[I] then
  1087.           ComponentList.Add(TComponent(Items.Objects[I]){Dataset.FieldByName(Items[I])});
  1088.     CopyComponents(Dataset.Owner, ComponentList);
  1089.   finally
  1090.     ComponentList.Free;
  1091.   end;
  1092. end;
  1093.  
  1094. procedure TFieldsEditor.Paste;
  1095. var
  1096.   I, Index: Integer;
  1097.   ComponentList: TDesignerSelectionList;
  1098.   Field, F: TField;
  1099. begin
  1100.   ComponentList := TDesignerSelectionList.Create;
  1101.   try
  1102.     F := nil;
  1103.     with FieldListBox do
  1104.       if (ItemIndex <> -1) and (Items.Count > 0) then
  1105.         F := TField(Items.Objects[ItemIndex]){Dataset.FieldByName(Items[ItemIndex])};
  1106.     try
  1107.       FDSDesigner.BeginDesign;
  1108.       try
  1109.         PasteComponents(Dataset.Owner, Dataset, ComponentList);
  1110.       finally
  1111.         FDSDesigner.EndDesign;
  1112.       end;
  1113.     finally
  1114.       UpdateDisplay;
  1115.     end;
  1116.     try
  1117.       with FieldListBox do
  1118.         for I := 0 to Items.Count - 1 do Selected[I] := False;
  1119.       for I := 0 to ComponentList.Count - 1 do
  1120.         if ComponentList[I] is TField then
  1121.         begin
  1122.           Field := TField(ComponentList[I]);
  1123.           Field.Name := UniqueName(Field);
  1124.           Index := FieldListBox.Items.IndexOf(Field.FullName);
  1125.           if Index <> -1 then FieldListBox.Selected[Index] := True;
  1126.           if F <> nil then Field.Index := F.Index;
  1127.         end;
  1128.     finally
  1129.       UpdateDisplay;
  1130.     end;
  1131.   finally
  1132.     ComponentList.Free;
  1133.   end;
  1134. end;
  1135.  
  1136. procedure TFieldsEditor.FormModified;
  1137. begin
  1138.   UpdateCaption;
  1139. end;
  1140.  
  1141. procedure TFieldsEditor.SelectionChanged(ASelection: TDesignerSelectionList);
  1142. var
  1143.   I: Integer;
  1144.   S: Boolean;
  1145.  
  1146.   function InSelection(Component: TComponent): Boolean;
  1147.   var
  1148.     I: Integer;
  1149.   begin
  1150.     Result := True;
  1151.     if ASelection <> nil then
  1152.       with ASelection do
  1153.         for I := 0 to Count - 1 do
  1154.           if Component = Items[I] then Exit;
  1155.     Result := False;
  1156.   end;
  1157.  
  1158. begin
  1159.   with FieldListBox do
  1160.     for I := 0 to Items.Count - 1 do
  1161.     begin
  1162.       S := InSelection(TComponent(Items.Objects[I]){Dataset.FieldList[I]});
  1163.       if Selected[I] <> S then Selected[I] := S;
  1164.     end;
  1165.   with AggListBox do
  1166.     for I := 0 to Items.Count - 1 do
  1167.     begin
  1168.       S := InSelection(TComponent(Items.Objects[I]){Dataset.AggFields[I]});
  1169.       if Selected[I] <> S then Selected[I] := S;
  1170.     end;
  1171. end;
  1172.  
  1173. procedure TFieldsEditor.SelectTable(Sender: TObject);
  1174. var
  1175.   I: Integer;
  1176. begin
  1177.   FieldListBox.ItemIndex := 0;
  1178.   with FieldListBox do
  1179.     for I := 0 to Items.Count - 1 do
  1180.       if Selected[I] then Selected[I] := False;
  1181.   UpdateSelection;
  1182.   FieldListBox.SetFocus;
  1183. end;
  1184.  
  1185. procedure TFieldsEditor.AListBoxClick(Sender: TObject);
  1186. begin
  1187.   UpdateSelection;
  1188. end;
  1189.  
  1190. procedure TFieldsEditor.AListBoxKeyPress(Sender: TObject;
  1191.   var Key: Char);
  1192. begin
  1193.   case Key of
  1194.     #13, #33..#126:
  1195.       begin
  1196.         if Key = #13 then Key := #0;
  1197.         ActivateInspector(Key);
  1198.         Key := #0;
  1199.       end;
  1200.     #27:
  1201.       begin
  1202.         SelectTable(Self);
  1203.         Key := #0;
  1204.       end;
  1205.   end;
  1206. end;
  1207.  
  1208. procedure TFieldsEditor.ClearAllClick(Sender: TObject);
  1209. begin
  1210.   CheckFieldDelete;
  1211.   if MessageDlg(SDSConfirmDeleteAll, mtConfirmation, mbOKCancel, 0) <> idCancel then
  1212.   begin
  1213.     SelectAll;
  1214.     RemoveFields(GetActiveListbox);
  1215.   end;
  1216. end;
  1217.  
  1218. procedure TFieldsEditor.FieldListBoxStartDrag(Sender: TObject;
  1219.   var DragObject: TDragObject);
  1220. begin
  1221.   if FieldListBox.Items.Count > 0 then
  1222.   begin
  1223.     if FDragObject = nil then
  1224.       FDragObject := TDragFields.Create(FieldListBox, Self);
  1225.     DragObject := FDragObject;
  1226.   end;
  1227. end;
  1228.  
  1229. procedure TFieldsEditor.SelectAllItemClick(Sender: TObject);
  1230. begin
  1231.   SelectAll;
  1232.   UpdateSelection;
  1233. end;
  1234.  
  1235. procedure TFieldsEditor.CutItemClick(Sender: TObject);
  1236. begin
  1237.   Cut;
  1238. end;
  1239.  
  1240. procedure TFieldsEditor.CopyItemClick(Sender: TObject);
  1241. begin
  1242.   Copy;
  1243. end;
  1244.  
  1245. procedure TFieldsEditor.PasteItemClick(Sender: TObject);
  1246. begin
  1247.   Paste;
  1248. end;
  1249.  
  1250. procedure TFieldsEditor.LocalMenuPopup(Sender: TObject);
  1251. var
  1252.   EditState: TEditState;
  1253. begin
  1254.   EditState := GetEditState;
  1255.   CopyItem.Enabled := esCanCopy in EditState;
  1256.   PasteItem.Enabled := esCanPaste in EditState;
  1257.   CutItem.Enabled := esCanCut in EditState;
  1258.   DeleteItem.Enabled := esCanDelete in EditState;
  1259.   SelectAllItem.Enabled := FieldListBox.Items.Count > 0;
  1260.   DSDesigner.UpdateMenus(LocalMenu, EditState);
  1261. end;
  1262.  
  1263. function TFieldsEditor.ForEachSelection(Proc: TSelectionProc): Boolean;
  1264. var
  1265.   Field: TField;
  1266.   I: Integer;
  1267. begin
  1268.   Result := False;
  1269.   with FieldListBox do
  1270.     for I := 0 to Items.Count - 1 do
  1271.       if Selected[I] then
  1272.       begin
  1273.         Field := TField(Items.Objects[I]){Dataset.FindField(Items[I])};
  1274.         if (Field <> nil) and not Proc(Field) then Exit;
  1275.       end;
  1276.   Result := True;
  1277. end;
  1278.  
  1279. procedure TFieldsEditor.AddAllFields(Sender: TObject);
  1280. begin
  1281.   AddFields(True);
  1282. end;
  1283.  
  1284. function TFieldsEditor.GetActiveListbox: TListbox;
  1285. begin
  1286.   if ActiveControl = AggListbox then
  1287.     Result := AggListbox
  1288.   else
  1289.     Result := FieldListBox;
  1290. end;
  1291.  
  1292. procedure TFieldsEditor.CheckFieldDelete;
  1293. var
  1294.   I: Integer;
  1295. begin
  1296.   with GetActiveListBox do
  1297.     for I := 0 to Items.Count-1 do
  1298.       if Selected[I] and (csAncestor in TField(Items.Objects[I]).ComponentState) then
  1299.         raise Exception.CreateRes(@SCantDeleteAncestor);
  1300. end;
  1301.  
  1302. procedure TFieldsEditor.CheckFieldAdd;
  1303. begin
  1304.   if (FDataset <> nil) and (FDataset.Owner <> nil) and
  1305.     (csInline in FDataset.Owner.ComponentState) then
  1306.     raise Exception.CreateRes(@SCantAddToFrame);
  1307. end;
  1308.  
  1309. initialization
  1310.   if Assigned(CompLib) then CompLib.RegisterDragTarget(TDragFields.ClassName, TFieldsTarget);
  1311. end.
  1312.  
  1313.